C/C++ Users Group Library 1996 July

home *** CD-ROM | disk | FTP | other *** search

/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_100 / 196_01 / fp64.csm < prev next >

Wrap

Text File | 1985-11-13 | 41KB | 3,082 lines

;/* ;***************************************************************** ;* Written by : Hakuo Katayose (JUG-CP/M No.179) * ;* JIP 980 * ;* 49-114 kawauchi-Sanjuunin-machi * ;* Sendai, Miyagi, Japan. * ;* Telph.No (0222)61-3219 * ;* Edited by : * ;* * ;***************************************************************** ;*/ ; INCLUDE "BDS.LIB" BIASEXP EQU 0400H NBYTES EQU 8 ; ;-------------------------------------------------------------- ;-------------------------------------------------------------- ; ; 64_bit INTEGER basic_subroutines. ; ; IMUL64 64_bit multiplay. LA = LA * (hl). ; IDIV64 64_bit divide. LA = LA / (hl). ; IADDA 64_bit addition. LA = LA + (hl). ; ISUBA 64_bit subtruction. LA = LA - (hl). ; ; IADD64 64_bit addition. (de) = (de) + (hl). ; ISUB64 64_bit subtruction. (de) = (de) - (hl). ; ; ICMP64 64_bit compare. c,z = (de) - (hl). ; ; INEG64 64_bit negation. (hl) = ~(hl). ; ; SFTL64 64_bit left shift. (carry set). ; SFTR64 64_bit right shift. (carry set). ; ; DSHFTL 128_bit left shift. ; DSHFTR 128_bit right shift. ; ; ITENTH 64_bit 10 times. (hl) = (hl) * 10. ; ; ; work area: ; TEN 64_bit constant. 10. ; LLWORK LLong type work_area. ; ;-------------------------------------------------------------- ; ; ;-------------------------------------------------------------- ;-------------------------------------------------------------- ; ; 64_bit floting opration result flags. ; ; EP 1 byte length. ; OUTSGN 1 byte length. ; OUTBUF 20 byte length. ; ; OVF 1 byte length. ; UNF 1 byte length. ; ZERO 1 byte length. ; MINUS 1 byte length. ; ;-------------------------------------------------------------- ; ; 64_bit floting work_registers. ; ; TEMPW 16 byte length. ; ; UU nbytes byte length. ; VV nbytes byte length. ; WW nbytes byte length. ; XX nbytes byte length. ; YY nbytes byte length. ; ;-------------------------------------------------------------- ; ; 64_bit floting Acc registers. ; ; LA 64_bit floting ACC_A. A_Acc extention. ; AREG 64_bit floting ACC_A. A_Acc. ; AEXP 64_bit floting ACC_A. expornemt. ; ASIGN 64_bit floting ACC_A. sign_flag. ; ; LB 64_bit floting ACC_B. B_Acc extention. ; BREG 64_bit floting ACC_B. B_Acc. ; BEXP 64_bit floting ACC_B. expornemt. ; BSIGN 64_bit floting ACC_B. sign_flag. ; ; TEN1 64_bit floting constant. 10.0 ; ONE 64_bit floting constant. 1.0 ; TENM1 64_bit floting constant. 0.1 ; NUM0 64_bit floting constant. 0.0 ; ; ; ; FUNCTION fp64 call arghak push b lda arg1 cpi 255 jz FPTST1 cpi 254 jz FPTST2 lhld arg1 dad h lxi b,JMPTBL dad b mov a,m inx h mov h,m mov l,a push h popix lhld arg3 xchg lhld arg2 ; de = arg3. hl = arg2. pcix JMPTBL: dw FPGETK dw FPADD ; no.1 dw FPSUB dw FPMUL dw FPDIV dw FPCMP dw FPNEG dw FPSFT dw FPHALF dw FPDBL dw FPCNV ; no.10 dw FPIN dw SQRT dw SIN dw ATAN2 dw EXPP dw LOG dw exitp ;jmp17 dw exitp ;jmp18 dw exitp ;jmp19 dw exitp ;jmp20 dw LLADD dw LLSUB dw LLMUL dw LLDIV dw LLCMP dw LLNEG dw LLMOV dw LLSFTL dw LLSFTR dw ATOLL dw LLTOA dw LLTEN exitp: lhld arg4 xchg call pack lxi h,OVF xra a ora m inx h ora m inx h ora m inx h ora m mov l,a mvi h,0 pop b ret ; ; ; FPADD: push h lxi h,BREG call unpack ; (arg3) --> Bcc. (Unpack). pop d lxi h,AREG call unpack ; (arg2) --> Acc. (Unpack). call FPADD0 jmp exitp ; ; FPSUB: push h lxi h,BREG call unpack ; (arg3) --> Bcc. (Unpack). pop d lxi h,AREG call unpack ; (arg2) --> Acc. (Unpack). call FPSUB0 jmp exitp ; ; FPMUL: push h lxi h,BREG call unpack ; (arg3) --> Bcc. (Unpack). pop d lxi h,AREG call unpack ; (arg2) --> Acc. (Unpack). call FPMUL0 jmp exitp ; ; FPDIV: push h lxi h,BREG call unpack ; (arg3) --> Bcc. (Unpack). pop d lxi h,AREG call unpack ; (arg2) --> Acc. (Unpack). call FPDIV0 jmp exitp ; ; FPCMP: lxi b,NBYTES-1 dad b xchg dad b ldax d ora a jp fpcmp1 mov a,m ora a xchg jm fpcmp2 lxi h,-1 pop b ret fpcmp1: mov a,m ora a jp fpcmp2 lxi h,1 pop b ret fpcmp2: call icmp64 lxi h,0 pop b rz lxi h,-1 rc lxi h,1 ret ; ; FPNEG: lhld arg2 xchg lhld arg4 xchg lxi b,NBYTES ldir lhld arg4 lxi b,nbytes-1 dad b mvi a,080h xra m mov m,a pop b ret ; ; FPCNV: xchg lxi h,AREG call unpack ; (arg2) --> Acc. (Unpack). jmp FPCONV ; ; LLADD: xchg lhld arg4 push h xchg lxi b,NBYTES ldir pop d lhld arg2 call iadd64 pop b ret LLSUB: xchg lhld arg4 push h xchg lxi b,NBYTES ldir pop d lhld arg3 call isub64 pop b ret LLMUL: lxi d,la lxi b,nbytes ldir lhld arg3 call imul64 lhld arg4 xchg lxi h,la lxi b,nbytes ldir pop b ret LLDIV: lxi d,la lxi b,nbytes ldir lhld arg3 call idiv64 lhld arg4 xchg lxi h,la lxi b,nbytes ldir pop b ret LLCMP: lxi b,NBYTES-1 dad b xchg lhld arg3 dad b ora a xchg lhld arg3 call icmp64 lxi h,0 pop b rz lxi h,-1 rc lxi h,1 ret LLNEG: call ineg64 pop b ret LLTEN: call itenth pop b ret LLMOV: xchg lhld arg4 xchg lxi b,nbytes ldir pop b ret LLSFTL: lda arg4 rar call sftl64 jmp sftext LLSFTR: lxi d,nbytes-1 dad d lda arg3 rar call sftr64 pop b sftext: lxi h,0 rnc lxi h,080h ret ATOLL: mvi a,' ' sta asign lxi h,0 shld la shld la+2 shld la+4 shld la+6 lhld arg2 encod1: mov a,m call isdigit jnc encod3 cpi ' ' jz encod2 cpi '+' jz encoda cpi '-' jnz encod8 mvi a,'-' sta asign encoda: inx h jmp encod3 encod2: inx h jmp encod1 encod3: mvi b,18 encod7: mov a,m call isdigit jnc encod9 cpi ',' jnz encod8 inx h jmp encod7 encod9: push b push h push psw lxi h,la call itenth pop psw ani 0fh lxi h,la add m mov m,a jnc encod5 mvi b,nbytes-1 encod4: inx h mvi a,0 adc m mov m,a jnc encod5 dcr b jnz encod4 encod5: pop h pop b inx h dcr b jnz encod7 encod8: lda asign cpi '-' lxi h,la cz ineg64 lhld arg4 xchg lxi h,la lxi b,nbytes ldir pop b ret LLTOA: lxi d,la lxi b,nbytes ldir lxi h,outbuf lxi d,outbuf+1 lxi b,18 mvi m,' ' ldir lxi h,outbuf+19 mvi m,0 lhld la mov a,h ora l jnz decode lhld la+2 mov a,h ora l jnz decode lhld la+4 mov a,h ora l jnz decode lhld la+6 mov a,h ora l jnz decode lxi h,outbuf+18 mvi m,'0' lxi h,outbuf pop b ret decode: lda la+nbytes-1 ani 080h mvi a,' ' jz decod1 lxi h,la call ineg64 mvi a,'-' decod1: sta outsgn lxi h,outbuf+18 mvi m,'0' decod3: push h lxi h,ten call idiv64 pop h jc decod4 lda la+nbytes adi '0' mov m,a dcx h mov a,m ana a jnz decod3 decod4: lda outsgn mov m,a lxi h,outbuf pop b ret FPHALF: xchg lhld arg4 xchg lxi b,nbytes ldir lhld arg4 lxi d,nbytes-2 dad d mov a,m sui 010h mov m,a jnc fphlf1 inx h dcr m fphlf1: pop b ret FPDBL: xchg lhld arg4 xchg lxi b,nbytes ldir lhld arg4 lxi d,nbytes-2 dad d mov a,m adi 010h mov m,a jnc fpdbl1 inx h inr m fpdbl1: pop b ret FPSFT: xchg lhld arg4 xchg lxi b,nbytes ldir lhld arg3 mov a,h ora l jz fpsft5 dad h dad h dad h dad h xchg lhld arg4 lxi b,nbytes-1 dad b push h mov a,m dcx h mov l,m mov h,a ani 080h dadc d jpo fpsft4 ; parity=odd --> no overflow. lxi h,0 jnc fpsft3 lxi h,07fffh fpsft3: ora h mov h,a fpsft4: xchg pop h mov m,d dcx h mov m,e fpsft5: pop b ret ; ;-------------------------------------------------------------- ; FLOATING POINT DIVIDE ------ Acc = Acc / Bcc. ;-------------------------------------------------------------- FPDIV0: lxi h,0 shld OVF shld ZERO lhld BEXP mov a,h ora l jz ovrfw lhld AEXP mov a,h ora l jz setzero ; fdiv1: lxi h,0 shld LA